home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / prog_bas / mquery.zip / MQUERY.FRM < prev    next >
Text File  |  1994-05-24  |  27KB  |  994 lines

  1. VERSION 2.00
  2. Begin Form fQuery 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "Query Builder"
  7.    ClientHeight    =   5730
  8.    ClientLeft      =   1425
  9.    ClientTop       =   2145
  10.    ClientWidth     =   9195
  11.    ClipControls    =   0   'False
  12.    ControlBox      =   0   'False
  13.    Height          =   6195
  14.    Icon            =   MQUERY.FRX:0000
  15.    KeyPreview      =   -1  'True
  16.    Left            =   1335
  17.    LinkTopic       =   "Form1"
  18.    MaxButton       =   0   'False
  19.    MinButton       =   0   'False
  20.    ScaleHeight     =   5709.895
  21.    ScaleMode       =   0  'User
  22.    ScaleWidth      =   9625.69
  23.    Top             =   1770
  24.    Width           =   9375
  25.    Begin SSPanel PnlHelp 
  26.       Alignment       =   1  'Left Justify - MIDDLE
  27.       AutoSize        =   1  'AutoSize Panel Width To Caption
  28.       BackColor       =   &H0000FFFF&
  29.       BevelOuter      =   0  'None
  30.       BorderWidth     =   1
  31.       Height          =   315
  32.       Left            =   3705
  33.       TabIndex        =   32
  34.       Top             =   1320
  35.       Visible         =   0   'False
  36.       Width           =   1965
  37.    End
  38.    Begin ListBox cColOrder 
  39.       BackColor       =   &H00C0C0C0&
  40.       Height          =   420
  41.       Left            =   6000
  42.       TabIndex        =   31
  43.       Top             =   1590
  44.       Width           =   3075
  45.    End
  46.    Begin CommandButton RunSaveQryButton 
  47.       Caption         =   "&Load Query"
  48.       Height          =   375
  49.       Left            =   4440
  50.       TabIndex        =   0
  51.       Top             =   4815
  52.       Width           =   1290
  53.    End
  54.    Begin CommandButton ExecSqlButton 
  55.       Caption         =   "&ExecSQL"
  56.       Height          =   375
  57.       Left            =   5835
  58.       TabIndex        =   1
  59.       Top             =   4815
  60.       Width           =   960
  61.    End
  62.    Begin SSPanel Panel3D1 
  63.       Align           =   2  'Align Bottom
  64.       Alignment       =   1  'Left Justify - MIDDLE
  65.       BevelInner      =   1  'Inset
  66.       FontBold        =   -1  'True
  67.       FontItalic      =   0   'False
  68.       FontName        =   "Arial"
  69.       FontSize        =   9.75
  70.       FontStrikethru  =   0   'False
  71.       FontUnderline   =   0   'False
  72.       Height          =   435
  73.       Left            =   0
  74.       TabIndex        =   29
  75.       Top             =   5295
  76.       Width           =   9195
  77.    End
  78.    Begin Frame Frame1 
  79.       BackColor       =   &H00C0C0C0&
  80.       Caption         =   "Display"
  81.       Height          =   495
  82.       Left            =   120
  83.       TabIndex        =   28
  84.       Top             =   4740
  85.       Width           =   3075
  86.       Begin OptionButton Option1 
  87.          BackColor       =   &H00C0C0C0&
  88.          Caption         =   "Grid"
  89.          Height          =   195
  90.          Index           =   0
  91.          Left            =   2100
  92.          TabIndex        =   19
  93.          Top             =   180
  94.          Value           =   -1  'True
  95.          Width           =   915
  96.       End
  97.       Begin OptionButton Option1 
  98.          BackColor       =   &H00C0C0C0&
  99.          Caption         =   "Record"
  100.          Height          =   195
  101.          Index           =   1
  102.          Left            =   840
  103.          TabIndex        =   18
  104.          Top             =   180
  105.          Width           =   975
  106.       End
  107.    End
  108.    Begin PictureBox ExpressionBox 
  109.       BackColor       =   &H00C0C0C0&
  110.       Height          =   1095
  111.       Left            =   120
  112.       ScaleHeight     =   1065
  113.       ScaleWidth      =   9705
  114.       TabIndex        =   24
  115.       Tag             =   "OL"
  116.       Top             =   240
  117.       Width           =   9735
  118.       Begin CommandButton GetValuesButton 
  119.          Caption         =   "List Possible &Values"
  120.          Height          =   252
  121.          Left            =   5955
  122.          TabIndex        =   17
  123.          Top             =   720
  124.          Width           =   2292
  125.       End
  126.       Begin ComboBox cValue 
  127.          BackColor       =   &H00C0C0C0&
  128.          Height          =   300
  129.          Left            =   5580
  130.          Sorted          =   -1  'True
  131.          TabIndex        =   14
  132.          Text            =   "cValue"
  133.          Top             =   375
  134.          Width           =   3330
  135.       End
  136.       Begin ComboBox cOperator 
  137.          BackColor       =   &H00C0C0C0&
  138.          Height          =   300
  139.          Left            =   4320
  140.          Style           =   2  'Dropdown List
  141.          TabIndex        =   13
  142.          Top             =   360
  143.          Width           =   1095
  144.       End
  145.       Begin ComboBox cField 
  146.          BackColor       =   &H00C0C0C0&
  147.          Height          =   300
  148.          Left            =   120
  149.          Style           =   2  'Dropdown List
  150.          TabIndex        =   12
  151.          Top             =   360
  152.          Width           =   4095
  153.       End
  154.       Begin CommandButton ORButton 
  155.          Caption         =   "&Or into Criteria"
  156.          Height          =   252
  157.          Left            =   2040
  158.          TabIndex        =   16
  159.          Top             =   720
  160.          Width           =   1812
  161.       End
  162.       Begin CommandButton ANDButton 
  163.          Caption         =   "&And into Criteria"
  164.          Height          =   252
  165.          Left            =   120
  166.          TabIndex        =   15
  167.          Tag             =   "Are you paying attention!!!!"
  168.          Top             =   720
  169.          Width           =   1812
  170.       End
  171.       Begin Label OperatorLabel 
  172.          BackColor       =   &H00C0C0C0&
  173.          Caption         =   "Operator:"
  174.          Height          =   195
  175.          Left            =   4320
  176.          TabIndex        =   27
  177.          Top             =   120
  178.          Width           =   975
  179.       End
  180.       Begin Label ValueLabel 
  181.          BackColor       =   &H00C0C0C0&
  182.          Caption         =   "Value:"
  183.          Height          =   195
  184.          Left            =   5520
  185.          TabIndex        =   26
  186.          Top             =   120
  187.          Width           =   1455
  188.       End
  189.       Begin Label FieldNameLabel 
  190.          BackColor       =   &H00C0C0C0&
  191.          Caption         =   "Field Name:"
  192.          Height          =   192
  193.          Left            =   120
  194.          TabIndex        =   25
  195.          Top             =   120
  196.          Width           =   1332
  197.       End
  198.    End
  199.    Begin CommandButton JoinButton 
  200.       Caption         =   "Set Table &Joins"
  201.       Height          =   255
  202.       Left            =   6240
  203.       TabIndex        =   10
  204.       Top             =   2670
  205.       Width           =   2535
  206.    End
  207.    Begin ListBox cJoinFields 
  208.       BackColor       =   &H00C0C0C0&
  209.       Height          =   420
  210.       Left            =   6000
  211.       TabIndex        =   11
  212.       Tag             =   "OL"
  213.       Top             =   2970
  214.       Width           =   3135
  215.    End
  216.    Begin ComboBox cOrderByField 
  217.       BackColor       =   &H00C0C0C0&
  218.       Height          =   300
  219.       Left            =   6000
  220.       Style           =   2  'Dropdown List
  221.       TabIndex        =   9
  222.       Tag             =   "OL"
  223.       Top             =   2310
  224.       Width           =   3135
  225.    End
  226.    Begin ListBox cTableList 
  227.       BackColor       =   &H00C0C0C0&
  228.       Height          =   1590
  229.       Left            =   120
  230.       MultiSelect     =   1  'Simple
  231.       TabIndex        =   6
  232.       Tag             =   "OL"
  233.       Top             =   1680
  234.       Width           =   2175
  235.    End
  236.    Begin ListBox cShowFields 
  237.       BackColor       =   &H00C0C0C0&
  238.       Height          =   1590
  239.       Left            =   2415
  240.       MultiSelect     =   1  'Simple
  241.       TabIndex        =   7
  242.       Tag             =   "OL"
  243.       Top             =   1650
  244.       Width           =   3510
  245.    End
  246.    Begin CommandButton CloseButton 
  247.       Cancel          =   -1  'True
  248.       Caption         =   "&Exit"
  249.       Height          =   375
  250.       Left            =   8070
  251.       TabIndex        =   3
  252.       Top             =   4815
  253.       Width           =   915
  254.    End
  255.    Begin CommandButton RunQueryButton 
  256.       Caption         =   "&Run Query"
  257.       Height          =   375
  258.       Left            =   3300
  259.       TabIndex        =   4
  260.       Top             =   4815
  261.       Width           =   1035
  262.    End
  263.    Begin CommandButton ClearButton 
  264.       Caption         =   "R&eset"
  265.       Height          =   375
  266.       Left            =   6900
  267.       TabIndex        =   2
  268.       Top             =   4815
  269.       Width           =   1095
  270.    End
  271.    Begin TextBox cCriteria 
  272.       BackColor       =   &H00C0C0C0&
  273.       Height          =   1215
  274.       Left            =   45
  275.       MultiLine       =   -1  'True
  276.       ScrollBars      =   2  'Vertical
  277.       TabIndex        =   5
  278.       Tag             =   "OL"
  279.       Top             =   3480
  280.       Width           =   9105
  281.    End
  282.    Begin Label lFilter 
  283.       AutoSize        =   -1  'True
  284.       BackColor       =   &H00C0C0C0&
  285.       Caption         =   "Select Filter"
  286.       Height          =   195
  287.       Left            =   120
  288.       TabIndex        =   30
  289.       Top             =   0
  290.       Width           =   1035
  291.    End
  292.    Begin Label OrberByFieldLabel 
  293.       BackColor       =   &H00C0C0C0&
  294.       Caption         =   "Order By Field:"
  295.       Height          =   195
  296.       Left            =   6000
  297.       TabIndex        =   8
  298.       Top             =   2070
  299.       Width           =   2055
  300.    End
  301.    Begin Label ColOrderLabel 
  302.       BackColor       =   &H00C0C0C0&
  303.       Caption         =   "Column Order:"
  304.       Height          =   195
  305.       Left            =   6000
  306.       TabIndex        =   23
  307.       Top             =   1380
  308.       Width           =   2055
  309.    End
  310.    Begin Label TableListLabel 
  311.       BackColor       =   &H00C0C0C0&
  312.       Caption         =   "Select Tables:"
  313.       Height          =   195
  314.       Left            =   120
  315.       TabIndex        =   22
  316.       Top             =   1440
  317.       Width           =   1455
  318.    End
  319.    Begin Label ShowFieldsLabel 
  320.       BackColor       =   &H00C0C0C0&
  321.       Caption         =   "Select Fields to Show:"
  322.       Height          =   195
  323.       Left            =   2400
  324.       TabIndex        =   21
  325.       Top             =   1440
  326.       Width           =   2055
  327.    End
  328.    Begin Label CriteriaLabel 
  329.       BackColor       =   &H00C0C0C0&
  330.       Caption         =   "Criteria:"
  331.       Height          =   180
  332.       Left            =   120
  333.       TabIndex        =   20
  334.       Top             =   3270
  335.       Width           =   1335
  336.    End
  337. End
  338.  
  339. Sub ANDButton_Click ()
  340.   ShowHelp ANDButton, 0, 0
  341.   Dim f As field
  342.   Dim ns As Integer
  343.   Dim nsflds As String
  344.   Dim nt As Integer
  345.   Dim ntflds As String
  346.  
  347.   If cField = "" Then Exit Sub
  348.  
  349.     If UCase(Left(cField, 4)) = "DBO." Then
  350.     nsflds = Mid(cField, 5, Len(cField))
  351.     Else
  352.     nsflds = cField
  353.     End If
  354.  
  355.   Set f = gCurrentDB.TableDefs(stSTF((nsflds), 0)).Fields(stSTF((nsflds), 1))
  356.   
  357.  If cCriteria <> "" Then
  358.     cCriteria = cCriteria + Chr(13) + Chr(10) + "And "
  359.   End If
  360.   If f.Type = FT_STRING Or f.Type = FT_MEMO Then
  361.      ns = InStr(1, cField, ".")
  362.      nsflds = Mid(cField, ns + 1, Len(cField))
  363.      ntflds = Left(cField, ns - 1)
  364.         nt = InStr(1, ntflds, " ")
  365.         If nt > 0 Then
  366.         ntflds = "[" + ntflds + "]"
  367.         nsflds = ntflds + "." + "[" + nsflds + "]"
  368.         Else
  369.         nsflds = "[" + nsflds + "]"
  370.         nsflds = Left(cField, ns) + nsflds
  371.         End If
  372.       nt = InStr(1, cValue, "'")
  373.       If nt > 0 Then
  374.       ntflds = Chr(34) + cValue + Chr(34)
  375.      cCriteria = cCriteria + "((" + nsflds + " " + cOperator + " " + ntflds + "))"
  376.      Else
  377.     cCriteria = cCriteria + nsflds + " " + cOperator + " '" + cValue + "'"
  378.      End If
  379.   Else
  380.      'If f.Type = FT_DATETIME Then
  381.          ns = InStr(1, cField, ".")
  382.          nsflds = Mid(cField, ns + 1, Len(cField))
  383.          ntflds = Left(cField, ns - 1)
  384.          nt = InStr(1, ntflds, " ")
  385.         If nt > 0 Then
  386.         ntflds = "[" + ntflds + "]"
  387.         nsflds = ntflds + "." + "[" + nsflds + "]"
  388.         Else
  389.         nsflds = "[" + nsflds + "]"
  390.         nsflds = Left(cField, ns) + nsflds
  391.         End If
  392.         If f.Type = FT_DATETIME Then
  393.         cValue = "#" + cValue + "#"
  394.         End If
  395.     'End If
  396.  
  397.     cCriteria = cCriteria + nsflds + " " + cOperator + " " + cValue
  398.   End If
  399.   cField.SetFocus
  400. End Sub
  401.  
  402. Sub ANDButton_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
  403.     ShowHelp ANDButton, x, y
  404. End Sub
  405.  
  406. Sub cCriteria_GotFocus ()
  407. ExecSqlButton.Enabled = True
  408. RunSaveQryButton.Enabled = False
  409. End Sub
  410.  
  411. Sub cField_Click ()
  412.   cValue.Clear
  413. End Sub
  414.  
  415. Sub ClearButton_Click ()
  416. resetdefault
  417. End Sub
  418.  
  419. Sub CloseButton_Click ()
  420.  
  421. End
  422.  
  423. End Sub
  424.  
  425. Sub cShowFields_Click ()
  426.  
  427. If cShowfields.ListCount = 0 Then
  428. CriteriaLabel.Caption = "SQL Statement"
  429. Exit Sub
  430. End If
  431.  
  432. ' which item was clicked on
  433. ' is it already in the colorder box if so remove it
  434. For j% = 0 To cColOrder.ListCount - 1
  435. If cColOrder.List(j%) = cShowfields.List(cShowfields.ListIndex) Then
  436. cColOrder.RemoveItem (j%)
  437. removed% = True
  438. Exit For
  439. End If
  440. Next j%
  441. If Not removed% Then ' must be an add not a remove
  442. addit$ = cShowfields.List(cShowfields.ListIndex)
  443. cColOrder.AddItem addit$
  444. removed% = False
  445. End If
  446.  
  447. CriteriaLabel.Caption = "Criteria:"
  448. For h% = 0 To cShowfields.ListCount - 1
  449. If cShowfields.Selected(h%) Then
  450.     RunQueryButton.Enabled = True
  451.     ExecSqlButton.Enabled = False
  452.    If RunSaveQryButton.Caption = "&Load Query" Then
  453.     RunSaveQryButton.Enabled = False
  454.    End If
  455. Exit Sub
  456. End If
  457. Next
  458. RunQueryButton.Enabled = False
  459. ExecSqlButton.Enabled = True
  460. End Sub
  461.  
  462. Sub cTableList_Click ()
  463.     On Error GoTo errtrap
  464.     If deselect > 0 Then
  465.     deselect = 0
  466.     Exit Sub
  467.     End If
  468.   Dim I As Integer, ii As Integer
  469.   Dim t As TableDef
  470.   Dim q As QueryDef
  471.   Dim st As String
  472.   Dim trap As Integer
  473.  
  474.   cCriteria.Text = ""
  475.   cField.Clear
  476.   cShowfields.Clear
  477.   cColOrder.Clear
  478.   cOrderByField.Clear
  479.   cValue.Clear
  480.   If RunQueryButton.Enabled = True Then
  481.       RunSaveQryButton.Enabled = True
  482.       RunQueryButton.Enabled = False
  483.       ExecSqlButton.Enabled = True
  484.       CriteriaLabel.Caption = "SQL Statement"
  485.   End If
  486.   gStoredFlag = False
  487.   cOrderByField.AddItem "(none)"
  488.  
  489.   For ii = 0 To cTableList.ListCount - 1
  490.     If cTableList.Selected(ii) Then
  491.     'RunQueryButton.Enabled = True
  492.       Set t = gCurrentDB.TableDefs(cTableList.List(ii))
  493.       For I = 0 To t.Fields.Count - 1
  494.     st = cTableList.List(ii) + "." + t.Fields(I).Name
  495.         If UCase(Left(st, 4)) = "DBO." Then
  496.         st = Mid(st, 5, Len(st))
  497.         End If
  498.  
  499.     cField.AddItem st
  500.     cShowfields.AddItem st
  501.     'cColOrder.AddItem st
  502.     cOrderByField.AddItem st
  503.       Next
  504.     End If
  505.     
  506.   Next
  507.   If cField.List(0) <> "" Then
  508.     cField.ListIndex = 0
  509.     'cColOrder.ListIndex = 0
  510.     cOrderByField.ListIndex = 0
  511.   End If
  512.   
  513. exitit:
  514. Exit Sub
  515. errtrap:
  516.   trap = MsgBox("Cannot use this file", 0, "Query")
  517.   Resume exitit
  518.  
  519. End Sub
  520.  
  521. Sub ExecSqlButton_Click ()
  522. ExecSql
  523. If Not gfFROMSQL And Not gStoredFlag Then
  524.     
  525.  MsgBox "No SQL Statement to Execute!", 48
  526.  NoCritflag = False
  527. End If
  528. End Sub
  529.  
  530. Sub Form_Load ()
  531.  
  532.    fQuery.Left = (screen.Width - fQuery.Width) / 2
  533.    fQuery.Top = (screen.Height - fQuery.Height) / 2
  534.  
  535.    On Local Error GoTo FLErr
  536.  
  537.    Dim ds As DynaSet
  538.    Dim I As Integer
  539.    Dim t As TableDef
  540.    Dim q As QueryDef
  541.    'Clear listbox
  542.    cCriteria = ""
  543.  
  544.    'Fill the Operator combo
  545.    cOperator.AddItem "="
  546.    cOperator.AddItem "<>"
  547.    cOperator.AddItem ">"
  548.    cOperator.AddItem ">="
  549.    cOperator.AddItem "<"
  550.    cOperator.AddItem "<="
  551.    cOperator.AddItem "Like"
  552.    cOperator.ListIndex = 0
  553.    cTableList.ListIndex = 0
  554.    CriteriaLabel.Caption = "SQL Statement"
  555.    RunSaveQryButton.Caption = "&Load Query"
  556.    RunQueryButton.Enabled = False
  557.    cValue = ""
  558.  
  559.   GoTo FLEnd
  560.  
  561. FLErr:
  562.   ShowError
  563.   Resume FLEnd
  564.  
  565. FLEnd:
  566. Me.Show
  567. End Sub
  568.  
  569. Sub Form_Paint ()
  570.   Outlines Me
  571.   PicOutlines ExpressionBox, cField
  572.   PicOutlines ExpressionBox, cOperator
  573.   PicOutlines ExpressionBox, cValue
  574. End Sub
  575.  
  576. Sub Form_Resize ()
  577.   On Error Resume Next
  578.  
  579.   If WindowState <> 1 Then
  580.     Height = 6050
  581.     'Width = 7224
  582.     Width = 9315'250
  583.   End If
  584. End Sub
  585.  
  586. Sub GetValuesButton_Click ()
  587.   Dim ds As DynaSet
  588.   Dim dsString As String
  589.   Dim ns As Integer
  590.   Dim fldn As String
  591.   Dim nv As String
  592.   cValue.Clear
  593.     ' search for sql .dbo and strip
  594.  
  595.     If UCase(Left(cField, 4)) = "DBO." Then
  596.     fldn = Mid(cField, 5, Len(cField))
  597.     ns = InStr(1, fldn, ".")
  598.     nv = Left(fldn, ns - 1)
  599.     fldn = "[" + Mid(fldn, ns + 1, Len(fldn)) + "]"
  600.     fldn = nv + "." + fldn
  601.  
  602.     dsString = "select Distinct " + fldn + " from "
  603.     Else
  604.     ns = InStr(1, cField, ".")
  605.     fldn = Mid(cField, ns + 1, Len(cField))
  606.     nv = Left(cField, ns - 1)
  607.     nt% = InStr(1, nv, " ")
  608.     If nt% > 0 Then
  609.      fldn = "[" + nv + "]" + "." + "[" + fldn + "]"
  610.     Else
  611.     fldn = Left(cField, ns) + "[" + fldn + "]"
  612.     End If
  613.     dsString = "select Distinct " + fldn + " from "
  614.     End If
  615.  
  616.   On Error GoTo GVErr
  617.  
  618.   MsgBar "Getting Possible Values", True
  619.   SetHourGlass Me
  620.   Set ds = gCurrentDB.CreateDynaset(dsString + stSTF((fldn), 0))
  621.   Do While ds.EOF = False
  622.     If Trim(ds(0)) <> "" Then
  623.       cValue.AddItem ds(0).Value
  624.     End If
  625.     ds.MoveNext
  626.   Loop
  627.   ds.Close
  628.   cValue = cValue.List(0)
  629.   cValue.SetFocus
  630.  
  631.   GoTo GVEnd
  632.  
  633. GVErr:
  634.   cValue = ""
  635.   Resume GVEnd
  636.  
  637. GVEnd:
  638.   ResetMouse Me
  639.   MsgBar "", False
  640.  
  641. End Sub
  642.  
  643. Sub JoinButton_Click ()
  644.   Dim I As Integer
  645.   Dim c As Integer
  646.  
  647.   For I = 0 To cTableList.ListCount - 1
  648.     If cTableList.Selected(I) = True Then
  649.       c = c + 1
  650.     End If
  651.   Next
  652.   If c < 2 Then
  653.     Beep
  654.     MsgBox "You Must Have at Least 2 Tables Selected!", 48
  655.   Else
  656.     MsgBar "Choose Joins", False
  657.     fJoin.Show MODAL
  658.     MsgBar "", False
  659.   End If
  660. End Sub
  661.  
  662. Sub ORButton_Click ()
  663.   Dim f As field
  664.   Dim ns As Integer
  665.   Dim nsflds As String
  666.   Dim nt As Integer
  667.   Dim ntflds As String
  668.  
  669.   If cField = "" Then Exit Sub
  670.     If UCase(Left(cField, 4)) = "DBO." Then
  671.     nsflds = Mid(cField, 5, Len(cField))
  672.     Else
  673.     nsflds = cField
  674.     End If
  675.  
  676.   Set f = gCurrentDB.TableDefs(stSTF((cField), 0)).Fields(stSTF((cField), 1))
  677.  
  678.   If cCriteria <> "" Then
  679.     cCriteria = cCriteria + Chr(13) + Chr(10) + " Or "
  680.   End If
  681.   If f.Type = FT_STRING Or f.Type = FT_MEMO Then
  682.      ns = InStr(1, cField, ".")
  683.      nsflds = Mid(cField, ns + 1, Len(cField))
  684.      ntflds = Left(cField, ns - 1)
  685.         nt = InStr(1, ntflds, " ")
  686.         If nt > 0 Then
  687.         ntflds = "[" + ntflds + "]"
  688.         nsflds = ntflds + "." + "[" + nsflds + "]"
  689.         Else
  690.         nsflds = "[" + nsflds + "]"
  691.         nsflds = Left(cField, ns) + nsflds
  692.         End If
  693.     cCriteria = cCriteria + nsflds + " " + cOperator + " '" + cValue + "'"
  694.   Else
  695.      If f.Type = FT_DATETIME Then
  696.          ns = InStr(1, cField, ".")
  697.          nsflds = Mid(cField, ns + 1, Len(cField))
  698.          ntflds = Left(cField, ns - 1)
  699.          nt = InStr(1, ntflds, " ")
  700.         If nt > 0 Then
  701.         ntflds = "[" + ntflds + "]"
  702.         nsflds = ntflds + "." + "[" + nsflds + "]"
  703.         Else
  704.         nsflds = "[" + nsflds + "]"
  705.         nsflds = Left(cField, ns) + nsflds
  706.         End If
  707.  
  708.         cValue = "#" + cValue + "#"
  709.     End If
  710.  
  711.  
  712.     cCriteria = cCriteria + nsflds + " " + cOperator + " " + cValue
  713.   End If
  714.   cField.SetFocus
  715.  
  716. End Sub
  717.  
  718. Sub RunQueryButton_Click ()
  719.  
  720.   On Error GoTo OKErr
  721.  
  722.      Dim ds As DynaSet
  723.      Dim fs As String
  724.      Dim ts As String
  725.      Dim I As Integer
  726.      Dim ns As Integer
  727.      Dim nsflds As String
  728.      Dim nt As Integer
  729.      Dim ntflds As String
  730.      Dim listnu As Integer
  731.      Dim joins As String
  732.      joins = ""
  733.      listnu = 0
  734.  
  735.     MsgBar "Building Query", True
  736.        For I% = 0 To cTableList.ListCount - 1
  737.     If cTableList.Selected(I%) Then
  738.     listnu = listnu + 1
  739.     End If
  740.       Next I
  741.         If listnu > 1 And cJoinFields.ListCount = 0 Then
  742.         MsgBox "You Must Have a Join for more than 1 Table Selected!", 48
  743.         Exit Sub
  744.         End If
  745.  
  746.      'check for join condition
  747.      If cJoinFields.ListCount > 0 Then
  748.        For I = 0 To cJoinFields.ListCount - 1
  749.      joins = joins + cJoinFields.List(I) + ","
  750.        Next
  751.        'get rid of last ,
  752.        joins = " " + Left(joins, Len(joins) - 1)
  753.        End If
  754.  
  755.  
  756.  
  757.      If cCriteria <> "" Then
  758.       StWhere$ = "AND " + LTrim(cCriteria)
  759.  
  760.        'strip CRLFs
  761.        For I = 1 To Len(StWhere$)
  762.      If Mid(StWhere$, I, 1) = Chr$(13) Then
  763.        stTmp$ = stTmp$ + " "
  764.      ElseIf Mid(StWhere$, I, 1) = Chr$(10) Then
  765.        'do nothing
  766.      Else
  767.        stTmp$ = stTmp$ + Mid(StWhere$, I, 1)
  768.      End If
  769.        Next
  770.        StWhere$ = stTmp$
  771.  
  772.        StWhere$ = RTrim(StWhere$)
  773.      
  774.        'Add parens to stWhere$
  775.     stTmpWhere$ = StWhere$
  776.     Do
  777.       stTmp$ = stGetToken(stTmpWhere$, " ")
  778.       If fMatchParen% = False And UCase(stTmp$) = "AND" Then
  779.         stNewWhere$ = stNewWhere$ + stTmp$ + " ("
  780.         fMatchParen% = True
  781.       ElseIf fMatchParen% = True And UCase(stTmp$) = "AND" Then
  782.         stNewWhere$ = stNewWhere$ + ") " + stTmp$ + " ("
  783.         'fMatchParen% = False
  784.       Else
  785.         If UCase(stTmp$) = "OR" Or UCase(stTmp$) = "IN" Or UCase(stTmp$) = "LIKE" Then
  786.           stNewWhere$ = stNewWhere$ + " " + stTmp$ + " "
  787.         Else
  788.           stNewWhere$ = stNewWhere$ + stTmp$
  789.         End If
  790.       End If
  791.  
  792.     Loop Until stTmpWhere$ = ""
  793.     StWhere$ = stNewWhere$ + ")"
  794.  
  795.        'Build DynaSet string:
  796.        'Peel off leading AND/OR
  797.        If Mid(StWhere$, 2, 2) = "OR" Then
  798.      StWhere$ = Mid(StWhere$, 5, Len(StWhere$) - 5)
  799.        Else
  800.      stTmp$ = stGetToken(StWhere$, " ")
  801.        End If
  802.  
  803.        If StWhere$ <> "" Then
  804.      StWhere$ = " Where " + StWhere$
  805.      Else
  806.      StWhere$ = " Where " + cCriteria
  807.        End If
  808.  
  809.      End If
  810.      ' get rid of brackets
  811.      ' check for more brackets until nomore
  812.      Do
  813.      ns = InStr(1, StWhere$, "'[")
  814.      If ns <> 0 Then
  815.      nsflds = Mid(StWhere$, 1, ns)
  816.      nv$ = Mid$(StWhere$, ns + 2, Len(StWhere$))
  817.      nsflds = nsflds + nv$
  818.      ns = InStr(1, nsflds, "]'")
  819.      nv$ = Mid$(nsflds, ns + 1, Len(nsflds))
  820.      nv$ = Mid(nsflds, 1, ns - 1) + nv$
  821.      StWhere$ = nv$
  822.      End If
  823.      Loop Until ns = 0
  824.  
  825.      'check for join condition
  826.      If joins <> "" Then
  827.      StWhere$ = "," + joins + " " + StWhere$
  828.      End If
  829.      'check
  830.      
  831.      'check for order by field
  832.      If cOrderByField <> "(none)" Then
  833.     '  check for dbo. in field
  834.     If UCase(Left(cOrderByField, 4)) = "DBO." Then
  835.         nsflds = Mid(cOrderByField, 5, Len(cOrderByField))
  836.         ns = InStr(1, nsflds, ".")
  837.         nsflds = "[" + Mid(nsflds, ns + 1, Len(nsflds)) + "]"
  838.         nv$ = Mid(cOrderByField, 5, ns) + nsflds
  839.         StWhere$ = StWhere$ + " Order By " + nv$
  840.     Else
  841.         ns = InStr(1, cOrderByField, ".")
  842.         nsflds = "[" + Mid(cOrderByField, ns + 1, Len(cOrderByField)) + "]"
  843.         nv$ = Left(cOrderByField, ns) + nsflds
  844.         StWhere$ = StWhere$ + " Order By " + nv$
  845.     End If
  846.      End If
  847.  
  848.      'get show field names and strip out sql servers dbo. field preface
  849.      For I% = 0 To cColOrder.ListCount - 1
  850.        If UCase(Left(cColOrder.List(I%), 4)) = "DBO." Then
  851.              nsflds = Mid(cColOrder.List(I%), 5, Len(cColOrder.List(I%)))
  852.              ns = InStr(1, nsflds, ".")
  853.              nsflds = Mid(nsflds, ns + 1, Len(nsflds))
  854.              nsflds = "[" + nsflds + "]"
  855.              nsflds = Left(Mid(cColOrder.List(I%), 5, Len(cColOrder.List(I%))), ns) + nsflds
  856.              fs = fs + nsflds + ","
  857.         Else
  858.         
  859.              ns = InStr(1, cColOrder.List(I%), ".")
  860.              nsflds = Mid(cColOrder.List(I%), ns + 1, Len(cColOrder.List(I%)))
  861.              ntflds = Left(cColOrder.List(I%), ns - 1)
  862.              nt = InStr(1, ntflds, " ")
  863.              If nt > 0 Then
  864.             ntflds = "[" + ntflds + "]"
  865.             nsflds = ntflds + "." + "[" + nsflds + "]"
  866.              Else
  867.              nsflds = "[" + nsflds + "]"
  868.              nsflds = Left(cColOrder.List(I%), ns) + nsflds
  869.              End If
  870.              
  871.              fs = fs + nsflds + ","
  872.        End If
  873.        Next
  874.      If fs = "" Then
  875.        For I% = 0 To cTableList.ListCount - 1
  876.     If cTableList.Selected(I%) Then
  877.         If UCase(Left(cTableList.Selected(I%), 4)) = ".DBO" Then
  878.         fs = fs + Mid(cTableList.Selected(I%), 5, Len(cTableList.Selected(I%)))
  879.          Else
  880.         fs = fs + cTableList.List(I%) + ".*,"
  881.         End If
  882.      End If
  883.        Next
  884.        If fs = "" Then
  885.      fs = "*"
  886.        Else
  887.      fs = Mid(fs, 1, Len(fs) - 1)     'take off the last ","
  888.        End If
  889.      Else
  890.        fs = Mid(fs, 1, Len(fs) - 1)
  891.      End If
  892.  
  893.      'get table names
  894.      For I% = 0 To cTableList.ListCount - 1
  895.        If cTableList.Selected(I%) Then
  896.         If UCase(Left(cTableList.List(I%), 4)) = "DBO." Then
  897.         ts = ts + Mid(cTableList.List(I%), 5, Len(cTableList.List(I%))) + ","
  898.          Else
  899.         ts = ts + cTableList.List(I%) + ","
  900.         End If
  901.        End If
  902.      Next
  903.      ts = Mid(ts, 1, Len(ts) - 1)
  904.      nt = InStr(1, ts, " ")
  905.      If nt > 0 Then
  906.      ts = "[" + ts + "]"
  907.      End If
  908.  
  909.      gstDynaString = "Select " + fs + " From " + ts + StWhere$
  910.      gfFROMSQL = False ' not a SQL statement
  911.  
  912. If Option1(0) = False Then
  913.      Dim dsform1 As New fDynaset
  914.      dsform1.Show
  915.        Else
  916.      Dim dsform2 As New fGridFrm
  917.      dsform2.Show
  918.        End If
  919.  
  920.  
  921.      GoTo OKEnd
  922.  
  923. OKErr:
  924.   If Err = 364 Then Resume OKEnd   'catch unloaded form
  925.   ShowError
  926.   Resume OKEnd
  927.  
  928. OKEnd:
  929.   MsgBar "", False
  930.  
  931. End Sub
  932.  
  933. Sub RunSaveQryButton_Click ()
  934.  
  935. fStoreQry.Show 1
  936.  
  937. If gstDynaString <> "" Then
  938. cCriteria.Text = gstDynaString
  939. MsgBar "Stored Query is Loaded", False
  940. Me.Tag = gstDynaString
  941.  
  942. gStoredFlag = True
  943. End If
  944.  
  945. End Sub
  946.  
  947. Function stGetToken (stLn$, stDelim$) As String
  948.     On Error GoTo GetTokenError
  949.  
  950.     iOpenQuote% = InStr(1, stLn$, """")
  951.     iDelim% = InStr(1, stLn$, stDelim$)
  952.     iBracket% = InStr(1, stLn$, "[")
  953.  
  954.     If (iOpenQuote% > 0) And (iOpenQuote% < iDelim%) Then
  955.      iCloseQuote% = InStr(iOpenQuote% + 1, stLn$, """")
  956.      iDelim% = InStr(iCloseQuote% + 1, stLn$, stDelim$)
  957.     End If
  958.  
  959.     If (iDelim% <> 0) And (iDelim% < iBracket%) Then
  960.      stToken$ = LTrim$(RTrim$(Mid$(stLn$, 1, iDelim% - 1)))
  961.      stLn$ = Mid$(stLn$, iDelim% + 1)
  962.     Else
  963.      stToken$ = LTrim$(RTrim$(Mid$(stLn$, 1)))
  964.      stLn$ = ""
  965.     End If
  966.  
  967.     If (Len(stToken$) > 0) Then
  968.      If (Mid$(stToken$, 1, 1) = """") Then
  969.           stToken$ = Mid$(stToken$, 2)
  970.      End If
  971.      If (Mid$(stToken$, Len(stToken$), 1) = """") Then
  972.           stToken$ = Mid$(stToken$, 1, Len(stToken$) - 1)
  973.      End If
  974.     End If
  975.     stGetToken = stToken$
  976.  
  977. GetTokenExit:
  978.     Exit Function
  979.  
  980. GetTokenError:
  981.     Resume GetTokenExit
  982. End Function
  983.  
  984. 'function to split the table and the field from a tbl.fld pair
  985. Function stSTF (tf As String, part As Integer) As String
  986.   If part = 0 Then
  987.  
  988.     stSTF = Mid(tf, 1, InStr(1, tf, ".") - 1)
  989.   Else
  990.     stSTF = Mid(tf, InStr(1, tf, ".") + 1, Len(tf))
  991.   End If
  992. End Function
  993.  
  994.